home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE10 / TIPTRIX / PACKTBL.PAS
Encoding:
Pascal/Delphi Source File  |  1996-05-22  |  1.0 KB  |  45 lines
  1. unit Packtbl;
  2.  
  3. interface
  4.  
  5. uses
  6.  
  7.  DBIProcs, DBIErrs, DBITypes, DB, DBTables, sysutils;
  8.  
  9. procedure PackTable(const tbl : TTable);
  10.  
  11. implementation
  12.  
  13. procedure PackTable(const tbl : TTable);
  14.  
  15. var
  16.  
  17.  dbResult : DBIResult;
  18.  
  19.  hDB : hDBIDb;
  20.  
  21.  hCursor : hDBICur;
  22.  
  23.  pszTablename : PChar;
  24.  
  25.  pszDriverType : PChar;
  26.  
  27.  bRegenIdxs : Boolean;
  28.  
  29.  StoreExcl : boolean;
  30.  
  31.  StoreActive : boolean;
  32.  
  33. begin
  34.  
  35.  StoreExcl := tbl.exclusive;
  36.  
  37.  StoreActive := tbl.Active;
  38.  
  39.  try
  40.  
  41.  try
  42.  
  43.  tbl.open;
  44.  
  45.  hDB := tbl.DBHandle;
  46.  
  47.  tbl.close;
  48.  
  49.  tbl.exclusive := true;
  50.  
  51.  except
  52.  
  53.  on E : Exception do
  54.  
  55.  raise Exception.create(
  56.  
  57.  'Error locking table for exclusive access:'+
  58.  
  59.  E.message);
  60.  
  61.  end;
  62.  
  63.  pszTableName := StrAlloc(25);
  64.  
  65.  StrPCopy(pszTableName, tbl.tablename);
  66.  
  67.  pszDriverType := StrAlloc(25);
  68.  
  69.  StrPCopy(pszDriverType, 'DBase');
  70.  
  71.  bRegenIdxs := true;
  72.  
  73.  dbResult := DBiPackTable(hDB, tbl.handle,
  74.  
  75.  pszTableName, pszDriverType, bRegenIdxs);
  76.  
  77.  if dbResult <> DBIERR_NONE then
  78.  
  79.  raise EDBEngineError.create(dbResult);
  80.  
  81.  finally
  82.  
  83.  tbl.exclusive := StoreExcl;
  84.  
  85.  tbl.active := StoreActive;
  86.  
  87.  end;
  88.  
  89. end;